home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibcat.zip / PIBCATS3.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-01  |  43KB  |  998 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Display_Help  --- Display help screen for PibCat              *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Help;
  6.  
  7. BEGIN (* Display_Help *)
  8.  
  9.    WRITELN;
  10.    WRITELN('Program: PIBCAT --- Catalog files on a disk.');
  11.    WRITELN('Author:  Philip R. Burns.');
  12.    WRITELN('Version: 1.7  April 1, 1989.');
  13.    WRITELN('Usage:   PIBCAT v /a /c /e=filespec /f=filespec /i=indent /l /m=margin /n');
  14.    WRITELN('                  /o=filename /p=pagesize /s=filespec /t=timezone /x /2');
  15.    WRITELN;
  16.    WRITELN('                v               volume (drive letter) to catalog');
  17.    WRITELN('                                (default is current drive)');
  18.    WRITELN('                                If given as ?, this text is displayed.');
  19.    WRITELN('                /a              Requests that PibCat output be appended to');
  20.    WRITELN('                                the file specified by "/o=".  Default is to');
  21.    WRITELN('                                overwrite the the output file.');
  22.    WRITELN('                /c=format       Produce condensed listing suitable for');
  23.    WRITELN('                                input to a database manager or sorting program.');
  24.    WRITELN('                                Two formats are available:  a columnar format');
  25.    WRITELN('                                specified as "/c=column" or a comma-delimited');
  26.    WRITELN('                                format specified as "/c=comma".  Specifying');
  27.    WRITELN('                                "/c" without a format produces the columnar');
  28.    WRITELN('                                format.  This option overrides all other');
  29.    WRITELN('                                formatting options.');
  30.    WRITELN('                /e=filespec     DOS file spec to match when listing');
  31.    WRITELN('                                entries in library files');
  32.    WRITELN('                                (default is *.* -- list all entries).');
  33.    WRITELN(' ');
  34.  
  35.    WRITE  ('Hit <Enter> to continue: ');
  36.    READLN;
  37.  
  38.    WRITELN;
  39.    WRITELN('                /f=filespec     DOS file spec to match when listing files');
  40.    WRITELN('                                (default is *.* -- list all files)');
  41.    WRITELN('                /i=indent       # columns to space for library entries');
  42.    WRITELN('                                (default is 0)');
  43.    WRITELN('                /l              display long file names');
  44.    WRITELN('                                (default is to display short file');
  45.    WRITELN('                                names only)');
  46.    WRITELN('                /m=margin       left margin to leave (default is 0)');
  47.    WRITELN('                /n              list contents of libraries at end of each');
  48.    WRITELN('                                subdirectory (default is list contents');
  49.    WRITELN('                                following library file name)');
  50.    WRITELN('                /o=filename     write catalog listing to file "filename"');
  51.    WRITELN('                                (default is "CATALOG.LIS")');
  52.    WRITELN('                /p=pagesize     paginate listing using "pagesize" lines');
  53.    WRITELN('                                (default is no pagination)');
  54.    WRITELN('                /s=filename     write status information to file "filename"');
  55.    WRITELN('                                (default is DOS standard output)');
  56.    WRITELN('                /t=timezone     number of hours local time lags/leads Greenwich');
  57.    WRITELN('                                Mean Time [GMT] (default is 7)');
  58.    WRITELN('                /x              don''t list library file contents');
  59.    WRITELN('                                (default is to list contents)');
  60.    WRITELN(' ');
  61.  
  62.    WRITE  ('Hit <Enter> to continue: ');
  63.    READLN;
  64.  
  65.    WRITELN;
  66.    WRITELN('                /2              Opens files without SHARE for DOS v2.x');
  67.    WRITELN('                                compatibility (default is to open files');
  68.    WRITELN('                                with share for DOS v3.1 and above)');
  69.    WRITELN;
  70.    WRITELN('Aborting:  Hit ^C to abort catalog listing.');
  71.    WRITELN;
  72.    WRITELN('Formats:   PibCat understands the contents of .ARC, .DWC, .LBR,');
  73.    WRITELN('           .LZH, .LZS, .MD, .PAK, .ZIP, and .ZOO files.');
  74.    WRITELN;
  75.  
  76. END   (* Display_Help *);
  77.  
  78. (*----------------------------------------------------------------------*)
  79. (*             Initialize --- Initialize PibCat program                 *)
  80. (*----------------------------------------------------------------------*)
  81.  
  82. FUNCTION Initialize : BOOLEAN;
  83.  
  84. VAR
  85.    S           : AnyStr;
  86.    S2          : AnyStr;
  87.    I           : INTEGER;
  88.    J           : INTEGER;
  89.    IErr        : INTEGER;
  90.    Dos_Version : WORD;
  91.  
  92. (* STRUCTURED *) CONST
  93.    Legit_Drives : SET OF CHAR = ['A'..'Z','?'];
  94.  
  95. BEGIN (* Initialize *)
  96.                                    (* --- Set defaults --- *)
  97.  
  98.                                    (* Drive to catalog is current drive *)
  99.    GetDir( 0 , S );
  100.    Cat_Drive         := UpCase( S[ 1 ] );
  101.  
  102.                                    (* Default output file is CATALOG.LIS *)
  103.  
  104.    Output_File_Name  := 'CATALOG.LIS';
  105.  
  106.                                    (* Default status file is standard output *)
  107.  
  108.    Status_File_Name  := '';
  109.  
  110.                                    (* Don't produce paginated listing file *)
  111.    Do_Printer_Format := FALSE;
  112.    Page_Size         := 0;
  113.                                    (* No extra spaces at left margin *)
  114.    Left_Margin       := 0;
  115.                                    (* No extra indent for libraries *)
  116.    Library_Indent    := 0;
  117.                                    (* List contents of library files *)
  118.    Expand_Libs       := TRUE;
  119.                                    (* Expand libraries after main listing *)
  120.    Expand_Libs_In    := TRUE;
  121.                                    (* No ^C hit yet terminating cataloguing *)
  122.    User_Break        := FALSE;
  123.                                    (* Catalog all files by default *)
  124.    Find_Spec         := '*.*';
  125.                                    (* Catalog all library entries by default *)
  126.    Entry_Spec        := '*.*';
  127.                                    (* We start on first page *)
  128.    Page_Number       := 1;
  129.                                    (* Lots of lines left on this page *)
  130.    Lines_Left        := 32767;
  131.                                    (* No files yet *)
  132.    File_Count        := 0;
  133.    Total_Files       := 0;
  134.    Total_Space       := 0;
  135.    Total_Entries     := 0;
  136.    Total_ESpace      := 0;
  137.    Total_Dirs        := 0;
  138.                                    (* No titles yet *)
  139.    Volume_Title      := '';
  140.    Subdir_Title      := '';
  141.    File_Title        := '';
  142.                                    (* Not help mode only *)
  143.    Help_Only         := FALSE;
  144.                                    (* Only short file names by default *)
  145.    Show_Long_File_Names := FALSE;
  146.                                    (* Assume we are using SHARE    *)
  147.    Use_Share         := TRUE;                                     
  148.                                    (* # of seconds local time leads/lags *)
  149.                                    (* Greenwich Mean Time (GMT)          *)
  150.  
  151.    GMT_Difference       := 8 * 3600;
  152.  
  153.                                    (* Assume we do daylight savings adjustment *)
  154.    Use_Daylight_Savings := TRUE;
  155.  
  156.                                    (* We aren't producing condensed output *)
  157.    Do_Condensed_Listing := FALSE;
  158.  
  159.                                    (* But if we were, it would be columnar *)
  160.  
  161.    Condensed_Listing_Type := Condensed_Columnar;
  162.  
  163.                                    (* Open output file for overwrite *)
  164.    Open_For_Append := FALSE;
  165.  
  166.                                    (* Grab command line parameters *)
  167.    FOR I := 1 TO ParamCount DO
  168.       BEGIN
  169.  
  170.          S := UpperCase( ParamStr( I ) );
  171.  
  172.          IF ( S[ 1 ] = '/' ) THEN
  173.             BEGIN
  174.  
  175.                IF ( S[3] = '=' ) THEN
  176.                   S2 := COPY( S, 4, LENGTH( S ) - 3 )
  177.                ELSE
  178.                   S2 := '';
  179.  
  180.                CASE UpCase( S[2] ) OF
  181.  
  182.                                    (* Open output for append  *)
  183.  
  184.                   'A':  Open_For_Append := TRUE;
  185.  
  186.                                    (* Write condensed listing *)
  187.  
  188.                   'C':  BEGIN
  189.                            Do_Condensed_Listing := TRUE;
  190.                            IF ( S2 = 'COMMA' ) THEN
  191.                               Condensed_Listing_Type := Condensed_Comma
  192.                            ELSE IF ( S2 = 'COLUMN' ) THEN
  193.                               Condensed_Listing_Type := Condensed_Columnar;
  194.                         END;   
  195.  
  196.                                    (* Match entry within libraries *)
  197.                   'E':  BEGIN
  198.                            IF ( S2 <> '' ) THEN
  199.                               Entry_Spec := S2;
  200.                            FOR J := 1 TO LENGTH( S2 ) DO
  201.                               Entry_Spec[ J ] := UpCase( Entry_Spec[ J ] );
  202.                         END;
  203.                                    (* Match this file spec *)
  204.                   'F':  BEGIN
  205.                            IF ( S2 <> '' ) THEN
  206.                               Find_Spec := S2;
  207.                         END;
  208.                                    (* # of space to indent when listing *)
  209.                                    (* contents of libraries             *)
  210.                   'I':  BEGIN
  211.                            VAL( S2, J, IErr );
  212.                            IF ( IErr = 0 ) THEN
  213.                               Library_Indent := J;
  214.                         END;
  215.  
  216.                                    (* If long file names should be listed *)
  217.  
  218.                   'L':  Show_Long_File_Names := TRUE;
  219.  
  220.                                    (* # of space in left margin of output *)
  221.                   'M':  BEGIN
  222.                            VAL( S2, J, IErr );
  223.                            IF ( IErr = 0 ) THEN
  224.                               Left_Margin := J;
  225.                         END;
  226.  
  227.                                    (* Expand libraries after all files *)
  228.                                    (* listed in a subdirectory         *)
  229.                   'N':  BEGIN
  230.                            Expand_Libs_In   := FALSE;
  231.                            Expand_Libs      := TRUE;
  232.                         END;
  233.                                    (* Output file name *)
  234.                                    
  235.                   'O':  Output_File_Name := S2;
  236.  
  237.                                    (* Page size for printing *)
  238.  
  239.                   'P':  BEGIN
  240.  
  241.                            VAL( S2, J, IErr );
  242.  
  243.                            IF ( IErr = 0 ) THEN
  244.                               BEGIN
  245.                                  Page_Size  := J;
  246.                                  Lines_Left := J;
  247.                               END;
  248.  
  249.                            Do_Printer_Format := ( Page_Size > 0 );
  250.  
  251.                         END;
  252.  
  253.                                    (* Status file name *)
  254.                                    
  255.                   'S':  Status_File_Name := S2;
  256.  
  257.                                    (* Number of hours or minutes local time *)
  258.                                    (* leads/lags Greenwich Mean Time        *)
  259.                   'T':  BEGIN
  260.  
  261.                            IF ( LENGTH( S2 ) > 0 ) THEN 
  262.                               BEGIN
  263.  
  264.                                  J := LENGTH( S2 );
  265.                                  
  266.                                  IF ( S2[ J ] = 'A' ) THEN
  267.                                     BEGIN
  268.                                        DELETE( S2 , J , 1 );
  269.                                        Use_Daylight_Savings := FALSE;
  270.                                     END;
  271.                                     
  272.                                  VAL( S2, J, IErr );
  273.  
  274.                                  IF ( IErr = 0 ) THEN
  275.                                     GMT_Difference := J;
  276.  
  277.                                  IF ( ABS ( GMT_Difference ) <= 12 ) THEN
  278.                                     GMT_Difference := GMT_Difference * 3600
  279.                                  ELSE
  280.                                     GMT_Difference := GMT_Difference * 60;   
  281.  
  282.                                  IF ( ABS( GMT_Difference  ) > ( 12 * 3600 ) ) THEN
  283.                                     GMT_Difference := 8 * 3600;    
  284.  
  285.                               END;
  286.  
  287.                         END;
  288.                                    (* If library contents should be expanded *)
  289.  
  290.                   'X':  Expand_Libs := FALSE;
  291.  
  292.                                    (* If SHARE to be used when opening files *)
  293.  
  294.                   '2':  Use_Share   := FALSE;
  295.  
  296.                   ELSE;
  297.  
  298.                END (* CASE *);
  299.  
  300.             END
  301.          ELSE
  302.             IF ( S[ 1 ] IN Legit_Drives ) THEN
  303.                Cat_Drive := S[ 1 ];
  304.       END;
  305.                                    (* Resolve output style parameter       *)
  306.                                    (* conflicts.  "/c" overrides others.   *)
  307.    IF Do_Condensed_Listing THEN
  308.       Do_Printer_Format := FALSE;
  309.  
  310.                                    (* If the drive was a "?" then we have  *)
  311.                                    (* a help request.  Display help info   *)
  312.                                    (* and quit.                            *)
  313.    IF ( Cat_Drive = '?' ) THEN
  314.       BEGIN
  315.          Display_Help;
  316.          Initialize := FALSE;
  317.          Help_Only  := TRUE;
  318.          EXIT;
  319.       END;
  320.                                    (* Fix up entry spec for comparisons    *)
  321.                                    (* later on.  If '*.*', then don't      *)
  322.                                    (* bother with entry spec checks later. *)
  323.  
  324.    Check_Entry_Spec( Entry_Spec, Entry_Name, Entry_Ext, Use_Entry_Spec );
  325.  
  326.                                    (* Get string of blanks for left margin *)
  327.  
  328.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  329.  
  330.                                    (* Get DOS version and set open *)
  331.                                    (* file modes accordingly.      *)
  332.  
  333.    I           := DosVersion;
  334.    Dos_Version := LO( I ) * 10 + HI( I );
  335.  
  336.    IF ( ( Dos_Version >= 31 ) AND Use_Share ) THEN
  337.       BEGIN
  338.          Read_Open_Mode  := 64;
  339.          Write_Open_Mode := 66;
  340.       END
  341.    ELSE
  342.       BEGIN
  343.          Read_Open_Mode  := 0;
  344.          Write_Open_Mode := 2;
  345.       END;
  346.                                    (* Open status file *)
  347.    FileMode := Write_Open_Mode;
  348.  
  349.    ASSIGN ( Status_File , Status_File_Name );
  350.    REWRITE( Status_File );
  351.  
  352.    FileMode := 2;
  353.                                    (* Continue if we got it *)
  354.    IF ( IOResult <> 0 ) THEN
  355.       BEGIN
  356.          WRITELN;
  357.          WRITELN( 'Can''t open status file ', Status_File_Name );
  358.          WRITELN;
  359.          Initialize := FALSE;
  360.          EXIT;
  361.       END;
  362.                                    (* Open output file *)
  363.    FileMode := Write_Open_Mode;
  364.  
  365.    ASSIGN    ( Output_File , Output_File_Name );
  366.    SetTextBuf( Output_File , Output_File_Buffer );
  367.  
  368.    IF Open_For_Append THEN
  369.       APPEND    ( Output_File )
  370.    ELSE
  371.       REWRITE   ( Output_File );
  372.  
  373.    FileMode := 2;
  374.                                    (* Continue if we got it *)
  375.    IF ( IOResult <> 0 ) THEN
  376.       BEGIN
  377.          WRITELN( Status_File );
  378.          WRITELN( Status_File , 'Can''t open output file ', Output_File_Name );
  379.          WRITELN( Status_File );
  380.          Initialize := FALSE;
  381.          EXIT;
  382.       END;
  383.                                    (* Prevent heap allocation death *)
  384.  
  385.    HeapError := @Heap_Error_Handler;
  386.  
  387.                                    (* See how many file segments we can get *)
  388.  
  389.    Stack_Alloc := PRED( ( MemAvail - 8192 ) DIV SIZEOF( File_Stack_Type ) );
  390.  
  391.                                    (* If we can't allocate even one segment *)
  392.                                    (* then report error and quit.           *)
  393.    IF ( Stack_Alloc < 0 ) THEN
  394.       BEGIN
  395.          WRITELN( Status_File );
  396.          WRITELN( Status_File , 'Not enough memory to process file directories ' );
  397.          WRITELN( Status_File );
  398.          Initialize := FALSE;
  399.          EXIT;
  400.       END
  401.    ELSE
  402.                                    (* Otherwise, allocate the segments *)
  403.       FOR I := 0 TO Stack_Alloc DO
  404.          NEW( File_Stack[ I ] );
  405.  
  406.                                    (* Get bracketing Unix dates for   *)
  407.                                    (* daylight savings time calcs.    *)
  408.    Get_Daylight_Savings_Times;
  409.  
  410.                                    (* Clear condensed output line     *)
  411.  
  412.    Condensed_Output_Line := DUPL( ' ' , 130 );
  413.  
  414.                                    (* Indicate initialization went OK *)
  415.    Initialize := TRUE;
  416.  
  417. END   (* Initialize *);
  418.  
  419. (*----------------------------------------------------------------------*)
  420. (*     Display_Volume_Label   ---  Display volume label of disk         *)
  421. (*----------------------------------------------------------------------*)
  422.  
  423. PROCEDURE Display_Volume_Label;
  424.  
  425. VAR
  426.    Vol_Time     : LONGINT;
  427.    STime        : STRING[10];
  428.    SDate        : STRING[10];
  429.  
  430. BEGIN (* Display_Volume_Label *)
  431.  
  432.                                    (* Blank out volume title line *)
  433.  
  434.    Volume_Title := DUPL( ' ' , 80 );
  435.  
  436.                                    (* Get volume label from DOS *)
  437.  
  438.    Dir_Get_Volume_Label( Cat_Drive, Volume_Label, Vol_Time );
  439.  
  440.                                    (* If condensed listing, stuff volume *)
  441.                                    (* label in output line and exit.     *)
  442.  
  443.    IF Do_Condensed_Listing THEN EXIT;
  444.  
  445.                                    (* If not condensed, make sure output *)
  446.                                    (* starts on a new line.              *)
  447.    WRITELN( Output_File );
  448.                                    (* If no volume label, don't output it. *)
  449.  
  450.    IF ( Volume_Label = '' ) THEN
  451.       BEGIN
  452.  
  453.          Volume_Title := Left_Margin_String              +
  454.                          ' Contents of volume on drive ' +
  455.                          Cat_Drive                       +
  456.                          ' as of '                       +
  457.                          DateString                      +
  458.                          '  '                            +
  459.                          TimeOfDayString;
  460.  
  461.          IF Do_Printer_Format THEN
  462.             BEGIN
  463.                WRITELN( Output_File , FF_Char );
  464.                WRITE  ( Output_File , Volume_Title );
  465.                WRITELN( Output_File , '     Page ', Page_Number );
  466.             END
  467.          ELSE
  468.             WRITELN( Output_File , Volume_Title );
  469.  
  470.          DEC( Lines_Left );
  471.  
  472.       END
  473.    ELSE
  474.                                    (* If volume label, output it along with *)
  475.                                    (* its creation time and date.           *)
  476.       BEGIN
  477.  
  478.          Volume_Title := Left_Margin_String        +
  479.                          ' Contents of volume '    +
  480.                          Volume_Label              +
  481.                          ' as of '                 +
  482.                          DateString                +
  483.                          '  '                      +
  484.                          TimeOfDayString;
  485.  
  486.          IF Do_Printer_Format THEN
  487.             BEGIN
  488.                WRITELN( Output_File , FF_Char );
  489.                WRITE  ( Output_File , Volume_Title );
  490.                WRITELN( Output_File , '     Page ', Page_Number );
  491.             END
  492.          ELSE
  493.             WRITELN( Output_File , Volume_Title );
  494.  
  495.          Volume_Label := Volume_Label + DUPL( ' ' , 12 - LENGTH( Volume_Label ) );
  496.  
  497.          Dir_Convert_Date_And_Time( Vol_Time , SDate , STime );
  498.  
  499.          WRITELN( Output_File );
  500.          WRITE  ( Output_File , Left_Margin_String,
  501.                   ' Volume: ',Volume_Label );
  502.  
  503.          IF ( SDate <> '         ' ) THEN
  504.             WRITE  ( Output_File , ' Created: ', SDate, '  ', STime );
  505.  
  506.          DEC( Lines_Left , 3 );
  507.  
  508.       END;
  509.  
  510.    WRITELN( Output_File );
  511.                                    (* Count lines left on page *)
  512.    DEC( Lines_Left , 2 );
  513.  
  514. END   (* Display_Volume_Label *);
  515.  
  516. (*----------------------------------------------------------------------*)
  517. (*     Display_Page_Titles  ---  Display page titles at top of page     *)
  518. (*----------------------------------------------------------------------*)
  519.  
  520. PROCEDURE Display_Page_Titles;
  521.  
  522. (*----------------------------------------------------------------------*)
  523. (*                                                                      *)
  524. (*    Procedure: Display_Page_Titles;                                   *)
  525. (*                                                                      *)
  526. (*    Purpose:   Displays page headers for paginated output file        *)
  527. (*                                                                      *)
  528. (*    Calling sequence:                                                 *)
  529. (*                                                                      *)
  530. (*       Display_Page_Titles;                                           *)
  531. (*                                                                      *)
  532. (*----------------------------------------------------------------------*)
  533.  
  534. BEGIN (* Display_Page_Titles *)
  535.                                    (* No titles if condensed listing   *)
  536.  
  537.    IF Do_Condensed_Listing THEN EXIT;
  538.  
  539.                                    (* Skip to top of new page using FF *)
  540.  
  541.    WRITELN( Output_File , FF_Char );
  542.  
  543.                                    (* Reset lines left to page size    *)
  544.    Lines_Left  := Page_Size;
  545.                                    (* Increment page count             *)
  546.  
  547.    INC( Page_Number );
  548.  
  549.                                    (* Display extant titles            *)
  550.                                    (*   -- Volume title                *)
  551.  
  552.    WRITELN( Output_File );
  553.    WRITELN( Output_File , Volume_Title , '     Page ', Page_Number );
  554.    WRITELN( Output_File );
  555.                                    (*   -- Subdirectory title          *)
  556.  
  557.    WRITELN( Output_File , Subdir_Title );
  558.    WRITELN( Output_File );
  559.  
  560.    DEC( Lines_Left , 5 );
  561.  
  562.    IF ( File_Title <> '' ) THEN
  563.       BEGIN
  564.                                    (*   -- File title          *)
  565.  
  566.          WRITELN( Output_File , File_Title );
  567.          WRITELN( Output_File );
  568.  
  569.          DEC( Lines_Left , 2 );
  570.  
  571.       END;
  572.  
  573. END   (* Display_Page_Titles *);
  574.  
  575. (*----------------------------------------------------------------------*)
  576. (*     Write_Condensed_Line --- Write summary line to output file       *)
  577. (*----------------------------------------------------------------------*)
  578.  
  579. PROCEDURE Write_Condensed_Line( VAR File_Name : AnyStr;
  580.                                     File_Size : LONGINT;
  581.                                     File_Time : LONGINT;
  582.                                 VAR Lib_Name  : AnyStr;
  583.                                 VAR File_Path : AnyStr  );
  584.  
  585. (*----------------------------------------------------------------------*)
  586. (*                                                                      *)
  587. (*    Procedure: Write_Condensed_Line                                   *)
  588. (*                                                                      *)
  589. (*    Purpose:   Writes one summary line for a file/entry               *)
  590. (*                                                                      *)
  591. (*    Calling sequence:                                                 *)
  592. (*                                                                      *)
  593. (*       Write_Condensed_Line( VAR File_Name : AnyStr;                  *)
  594. (*                                 File_Size : LONGINT;                 *)
  595. (*                                 File_Time : LONGINT;                 *)
  596. (*                             VAR Lib_Name  : AnyStr;                  *)
  597. (*                             VAR File_Path : AnyStr  );               *)
  598. (*                                                                      *)
  599. (*    Remarks:                                                          *)
  600. (*                                                                      *)
  601. (*       Here is the format of each summary line:                       *)
  602. (*                                                                      *)
  603. (*          Columns   Contents                                          *)
  604. (*          =======   ========                                          *)
  605. (*                                                                      *)
  606. (*           1 - 12   File name                                         *)
  607. (*          14 - 22   File size in bytes                                *)
  608. (*          24 - 31   Date in YY/MM/DD format                           *)
  609. (*          33 - 37   Time in 24 hour HH:MM format                      *)
  610. (*          39 - 50   Library Name  (if file is member of a library)    *)
  611. (*          52 - 63   Volume label                                      *)
  612. (*          65 - 130  Path (without trailing file name)                 *)
  613. (*                                                                      *)
  614. (*       If a file is a member of a library, then the path is that of   *)
  615. (*       the library file itself, NOT any path stored in the library.   *)
  616. (*                                                                      *)
  617. (*----------------------------------------------------------------------*)
  618.  
  619. VAR
  620.    SSize : STRING[ 10 ];
  621.    STime : STRING[ 10 ];
  622.    SDate : STRING[ 10 ];
  623.  
  624. BEGIN (* Write_Condensed_Line *)
  625.  
  626.                                    (* Blank output line beyond volume label *)
  627.  
  628.    FillChar( Condensed_Output_Line[ 1 ] , 130 , ' ' );
  629.  
  630.                                    (* Convert file size to characters *)
  631.  
  632.    STR( File_Size : 8 , SSize );
  633.  
  634.                                    (* Convert file time and date    *)
  635.  
  636.    Dir_Convert_Date_And_Time_2( File_Time , SDate , STime );
  637.  
  638.                                    (* Move file info to output line *)
  639.  
  640.    MOVE( File_Name[ 1 ]   , Condensed_Output_Line[  1 ], LENGTH( File_Name ) );
  641.    MOVE( SSize[ 1 ]       , Condensed_Output_Line[ 14 ], LENGTH( SSize ) );
  642.    MOVE( SDate[ 1 ]       , Condensed_Output_Line[ 24 ], LENGTH( SDate ) );
  643.    MOVE( STime[ 1 ]       , Condensed_Output_Line[ 33 ], LENGTH( STime ) );
  644.    MOVE( Lib_Name [ 1 ]   , Condensed_Output_Line[ 39 ], LENGTH( Lib_Name  ) );
  645.    MOVE( Volume_Label[ 1 ], Condensed_Output_Line[ 52 ], LENGTH( Volume_Label ) );
  646.    MOVE( File_Path[ 1 ]   , Condensed_Output_Line[ 65 ], LENGTH( File_Path ) );
  647.  
  648.                                    (* Insert commas if needed *)
  649.  
  650.    IF ( Condensed_Listing_Type = Condensed_Comma ) THEN
  651.       BEGIN
  652.          Condensed_Output_Line[ 13 ] := ',';
  653.          Condensed_Output_Line[ 23 ] := ',';
  654.          Condensed_Output_Line[ 32 ] := ',';
  655.          Condensed_Output_Line[ 38 ] := ',';
  656.          Condensed_Output_Line[ 51 ] := ',';
  657.          Condensed_Output_Line[ 64 ] := ',';
  658.       END;
  659.                                    (* Write summary line to output file *)
  660.  
  661.    WRITELN( Output_File , Condensed_Output_Line );
  662.  
  663. END   (* Write_Condensed_Line *);
  664.  
  665. (*----------------------------------------------------------------------*)
  666. (*     Display_Error --- Display an error message                       *)
  667. (*----------------------------------------------------------------------*)
  668.  
  669. PROCEDURE Display_Error( Error_Message : AnyStr );
  670.  
  671. (*----------------------------------------------------------------------*)
  672. (*                                                                      *)
  673. (*    Procedure: Display_Error                                          *)
  674. (*                                                                      *)
  675. (*    Purpose:   Displays an error message.                             *)
  676. (*                                                                      *)
  677. (*    Calling sequence:                                                 *)
  678. (*                                                                      *)
  679. (*       Display_Error( Error_Message : AnyStr );                       *)
  680. (*                                                                      *)
  681. (*----------------------------------------------------------------------*)
  682.  
  683. BEGIN (* Display_Error *)
  684.  
  685.    IF Do_Condensed_Listing THEN
  686.       WRITELN( Status_File , Left_Margin_String, '  >>> ' , Error_Message )
  687.    ELSE
  688.       BEGIN
  689.                                    (* See if there's room on this page *)
  690.                                    (* for error message.               *)
  691.  
  692.          IF ( Lines_Left < 1 ) THEN
  693.             Display_Page_Titles;
  694.                                    (* Write out error message *)
  695.  
  696.          WRITELN( Output_File , Left_Margin_String, '  >>> ' , Error_Message );
  697.  
  698.                                    (* Count lines left on page *)
  699.  
  700.          IF Do_Printer_Format THEN
  701.             BEGIN
  702.  
  703.                DEC( Lines_Left );
  704.  
  705.                IF ( Lines_Left < 1 ) THEN
  706.                   Display_Page_Titles;
  707.  
  708.             END;
  709.  
  710.       END;
  711.  
  712. END   (* Display_Error *);
  713.  
  714. (*----------------------------------------------------------------------*)
  715. (* Start_Contents_Listing --- Initialize listing of library contents     *)
  716. (*----------------------------------------------------------------------*)
  717.  
  718. FUNCTION Start_Contents_Listing(    File_Desc : AnyStr;
  719.                                     File_Name : AnyStr;
  720.                                 VAR Lib_File  : FILE;
  721.                                 VAR File_Pos  : LONGINT;
  722.                                 VAR Ierr      : INTEGER  ) : BOOLEAN;
  723.  
  724. (*----------------------------------------------------------------------*)
  725. (*                                                                      *)
  726. (*    Function:  Start_Contents_Listing                                 *)
  727. (*                                                                      *)
  728. (*    Purpose:   Initializes listing of library file contents           *)
  729. (*                                                                      *)
  730. (*    Calling sequence:                                                 *)
  731. (*                                                                      *)
  732. (*       OK := Start_Contents_Listing(     File_Desc : AnyStr;          *)
  733. (*                                         File_Name : AnyStr;          *)
  734. (*                                     VAR Lib_File  : FILE;            *)
  735. (*                                     VAR File_Pos  : LONGINT;         *)
  736. (*                                     VAR Ierr      : INTEGER  );      *)
  737. (*                                                                      *)
  738. (*          File_Desc --- Description of library file type              *)
  739. (*          File_Name --- Library file name                             *)
  740. (*          Lib_File  --- Library file handle                           *)
  741. (*          File_Pos  --- Initial position in library file              *)
  742. (*          Ierr      --- = 0 if file opened OK; <> 0 if error          *)
  743. (*                                                                      *)
  744. (*          OK        --- TRUE if library file opened OK.               *)
  745. (*                                                                      *)
  746. (*    Calls:                                                            *)
  747. (*                                                                      *)
  748. (*       DUPL                                                           *)
  749. (*       Display_Page_Titles                                            *)
  750. (*       Open_File                                                      *)
  751. (*                                                                      *)
  752. (*----------------------------------------------------------------------*)
  753.  
  754. BEGIN (* Start_Contents_Listing *)
  755.  
  756.                                    (* Set left margin spacing *)
  757.  
  758.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , Library_Indent );
  759.  
  760.                                    (* Set file title *)
  761.  
  762.    File_Title := Left_Margin_String + File_Desc + File_Name;
  763.  
  764.                                    (* Display library file's name *)
  765.    IF Do_Printer_Format THEN
  766.       IF ( Lines_Left < 3 ) THEN
  767.          Display_Page_Titles;
  768.                                    (* If we're listing contents at end  *)
  769.                                    (* of directory, print library name. *)
  770.                                    (* Do_Blank_Line flags whether we    *)
  771.                                    (* need to print blank line in entry *)
  772.                                    (* lister subroutine.  If listing    *)
  773.                                    (* inline, then it's true for the    *)
  774.                                    (* first file; otherwise it's false. *)
  775.                                    (* This is to prevent unnecessary    *)
  776.                                    (* blank lines in output listing     *)
  777.                                    (* when no files are selected from   *)
  778.                                    (* a given library.                  *)
  779.  
  780.    IF ( NOT Do_Condensed_Listing ) THEN
  781.       IF ( NOT Expand_Libs_In ) THEN
  782.          BEGIN
  783.             WRITELN( Output_File ) ;
  784.             WRITE  ( Output_File , File_Title );
  785.             DEC( Lines_Left , 2 );
  786.             Do_Blank_Line := FALSE;
  787.          END
  788.       ELSE
  789.          Do_Blank_Line := TRUE;
  790.                                    (* Make sure drive attached to file name *)
  791.  
  792.    IF ( POS( ':' , File_Name ) = 0 ) THEN
  793.       File_Name := Cat_Drive + ':' + File_Name;
  794.  
  795.                                    (* No entries displayed yet *)
  796.    Current_Entries := 0;
  797.  
  798.                                    (* Try opening library file for processing *)
  799.  
  800.    Open_File( File_Name, Lib_File, File_Pos, Ierr );
  801.  
  802.                                    (* Set flag indicating if open went OK *)
  803.  
  804.    Start_Contents_Listing := ( Ierr = 0 );
  805.  
  806.                                    (* If open fails, write error message *)
  807.    IF ( Ierr <> 0 ) THEN
  808.       Display_Error( 'Cannot open file ' + File_Name )
  809.  
  810.    ELSE IF ( NOT Expand_Libs_In ) THEN
  811.       IF ( NOT Do_Condensed_Listing ) THEN
  812.          BEGIN
  813.  
  814.             WRITELN( Output_File );
  815.             WRITELN( Output_File );
  816.  
  817.                                    (* Count lines left on page *)
  818.  
  819.             IF Do_Printer_Format THEN
  820.                DEC( Lines_Left );
  821.  
  822.          END;
  823.  
  824. END   (* Start_Contents_Listing *);
  825.  
  826. (*----------------------------------------------------------------------*)
  827. (*   End_Contents_Listing --- Finish listing of library contents        *)
  828. (*----------------------------------------------------------------------*)
  829.  
  830. PROCEDURE End_Contents_Listing( VAR Lib_File : FILE;
  831.                                     Error    : INTEGER );
  832.  
  833. (*----------------------------------------------------------------------*)
  834. (*                                                                      *)
  835. (*    Procedure: End_Contents_Listing                                   *)
  836. (*                                                                      *)
  837. (*    Purpose:   Finishes listing of library file contents              *)
  838. (*                                                                      *)
  839. (*    Calling sequence:                                                 *)
  840. (*                                                                      *)
  841. (*       End_Contents_Listing( VAR Lib_File : FILE;                     *)
  842. (*                                 Error    : INTEGER );                *)
  843. (*                                                                      *)
  844. (*          Lib_File  --- Library file handle                           *)
  845. (*          Error     --- Error type                                    *)
  846. (*                                                                      *)
  847. (*    Calls:                                                            *)
  848. (*                                                                      *)
  849. (*       DUPL                                                           *)
  850. (*       Close_File                                                     *)
  851. (*                                                                      *)
  852. (*----------------------------------------------------------------------*)
  853.  
  854. BEGIN (* End_Contents_Listing *)
  855.  
  856.                                    (* Display error message if necessary   *)
  857.  
  858.    IF ( Current_Entries > 0 ) THEN
  859.       CASE Error OF
  860.          Format_Error  : Display_Error( 'Bad file format' );
  861.          Too_Many_Subs : Display_Error( 'Too many nested subdirectories' );
  862.          ELSE;
  863.       END (* CASE *);
  864.                                    (* Print blank line after last entry    *)
  865.                                    (* in library, if we're expanding       *)
  866.                                    (* contents inline, but only if library *)
  867.                                    (* had any entries listed.              *)
  868.    IF ( Expand_Libs_In AND
  869.         ( NOT Do_Blank_Line ) AND ( NOT Do_Condensed_Listing ) ) THEN
  870.       BEGIN
  871.  
  872.          WRITELN( Output_File );
  873.  
  874.          IF Do_Printer_Format THEN
  875.             DEC( Lines_Left );
  876.  
  877.       END;
  878.                                    (* Close library file *)
  879.    Close_File( Lib_File );
  880.                                    (* Restore previous left margin spacing *)
  881.  
  882.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  883.  
  884.                                    (* No file title *)
  885.    File_Title := '';
  886.  
  887. END   (* End_Contents_Listing *);
  888.  
  889. (*----------------------------------------------------------------------*)
  890. (*     Display_One_Entry --- Write contents line to output file         *)
  891. (*----------------------------------------------------------------------*)
  892.  
  893. PROCEDURE Display_One_Entry( VAR File_Name : AnyStr;
  894.                                  File_Size : LONGINT;
  895.                                  File_Time : LONGINT;
  896.                              VAR Lib_Name  : AnyStr;
  897.                              VAR File_Path : AnyStr;
  898.                              VAR Long_Name : AnyStr  );
  899.  
  900. (*----------------------------------------------------------------------*)
  901. (*                                                                      *)
  902. (*    Procedure: Display_One_Entry                                      *)
  903. (*                                                                      *)
  904. (*    Purpose:   Writes information about one entry in library file     *)
  905. (*                                                                      *)
  906. (*    Calling sequence:                                                 *)
  907. (*                                                                      *)
  908. (*       Display_One_Entry( VAR File_Name : AnyStr;                     *)
  909. (*                              File_Size : LONGINT;                    *)
  910. (*                              File_Time : LONGINT;                    *)
  911. (*                          VAR Lib_Name  : AnyStr;                     *)
  912. (*                          VAR File_Path : AnyStr;                     *)
  913. (*                          VAR Long_Name : AnyStr  );                  *)
  914. (*                                                                      *)
  915. (*----------------------------------------------------------------------*)
  916.  
  917. VAR
  918.    STime : STRING[ 10 ];
  919.    SDate : STRING[ 10 ];
  920.    I     : INTEGER;
  921.  
  922. BEGIN (* Display_One_Entry *)
  923.                                    (* Write condensed-style line if *)
  924.                                    (* requested                     *)
  925.    IF Do_Condensed_Listing THEN
  926.       Write_Condensed_Line( File_Name, File_Size, File_Time, Lib_Name,
  927.                             File_Path )
  928.    ELSE
  929.       BEGIN                        (* Write normal style listing    *)
  930.  
  931.                                    (* Make sure room on current page *)
  932.                                    (* for this entry name.           *)
  933.                                    (* If enough room, print blank    *)
  934.                                    (* line if requested.  This will  *)
  935.                                    (* only happen for first file.    *)
  936.          IF Do_Blank_Line THEN
  937.             BEGIN
  938.                IF ( Lines_Left < 2 ) THEN
  939.                   Display_Page_Titles
  940.                ELSE
  941.                   BEGIN
  942.                      WRITELN( Output_File );
  943.                      DEC( Lines_left );
  944.                   END;
  945.                Do_Blank_Line := FALSE;
  946.             END
  947.          ELSE
  948.             IF ( Lines_Left < 1 ) THEN
  949.                Display_Page_Titles;
  950.  
  951.                                    (* Add '. ' to front if we're     *)
  952.                                    (* expanding ARCs in main listing *)
  953.          IF Expand_Libs_In THEN
  954.             File_Name := '. ' + File_Name;
  955.  
  956.                                    (* Convert date and time to displayable form *)
  957.  
  958.          Dir_Convert_Date_And_Time( File_Time , SDate , STime );
  959.  
  960.                                    (* Write out file name, length, date, time *)
  961.  
  962.          WRITE( Output_File , Left_Margin_String, '      ' , File_Name );
  963.  
  964.          FOR I := LENGTH( File_Name ) TO 14 DO
  965.             WRITE( Output_File , ' ' );
  966.  
  967.          WRITE  ( Output_File , File_Size:8, '  ' );
  968.          WRITE  ( Output_File , SDate, '  ' );
  969.          WRITE  ( Output_File , STime );
  970.  
  971.                                    (* See if we're to write out *)
  972.                                    (* long file names.  If so,  *)
  973.                                    (* write out subdirectory    *)
  974.                                    (* path followed by file     *)
  975.                                    (* name.                     *)
  976.  
  977.          IF Show_Long_File_Names THEN
  978.             WRITE( Output_File , '  ' , Long_Name );
  979.  
  980.                                    (* Finish output line       *)
  981.  
  982.          WRITELN( Output_File );
  983.  
  984.                                    (* Count lines left on page *)
  985.          IF Do_Printer_Format THEN
  986.             DEC( Lines_Left );
  987.  
  988.       END;
  989.                                    (* Increment total entry count *)
  990.    INC( Total_Entries );
  991.                                    (* Increment entry count this library *)
  992.    INC( Current_Entries );
  993.                                    (* Increment total space used  *)
  994.  
  995.    Total_ESpace := Total_ESpace + File_Size;
  996.  
  997. END   (* Display_One_Entry *);
  998.